SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00003 1 08-24-9413:31ALL RAPHAEL VANNEY Remove Records from File SWAG9408 f¼▌k 19 .l π{ The following procedure physically removes record(s) from any file,π then truncate the file. I use it to shrink log files and to removeπ index entries from Squish .SQI files, but many other uses may be found. }ππ{ Donated to the public domain by Raphaël Vanney. }ππUses DOS ;ππFunction DeleteRecs( Var AFile ;π From : LongInt ;π Count : LongInt ;π BufSize : Word) : Integer ;ππ{ AFile : any typed or untyped file (not Text), must be opened }π{ From : number of 1st record to delete, 0-based }π{ Count : number of record(s) to delete }π{ BufSize : size of the buffer to allocate. Must be > record size }ππVar Buffer : Pointer ; { pointer to buffer }π Src : LongInt ; { source record pointer }π Cnt : LongInt ; { scratch }π Last : LongInt ; { last record to move }π f : File Absolute AFile ; { file we're going to work on }π Err : Integer ; { error code }ππLabelπ Sortie ;ππBeginπ Last:=FileSize(f) ;π Src:=From+Count ;π If Count>(Last-From) Then Count:=Last-From ;ππ { check BufSize against FileRec(f).RecSize }π If (BufSize<FileRec(f).RecSize) Orπ (MaxAvail<BufSize) Thenπ Beginπ DeleteRecs:=1 ; { error }π Exit ;π End ;ππ GetMem(Buffer, BufSize) ;ππ While Src<Last Doπ Beginπ Cnt:=BufSize Div FileRec(f).RecSize ;π If (Src+Cnt)>Last Then Cnt:=Last-Src ;π Seek(f, Src) ;π BlockRead(f, Buffer^, Cnt) ;π { error check }π Err:=IOResult ;π If Err<>0 Then GoTo Sortie ;π Seek(f, From) ;π BlockWrite(f, Buffer^, Cnt) ;π { error check }π Err:=IOResult ;π If Err<>0 Then GoTo Sortie ;π Inc(Src, Cnt) ;π Inc(From, Cnt) ;π End ;ππ Seek(f, Last-Count) ;π Truncate(f) ;πSortie:π DeleteRecs:=Err ;π FreeMem(Buffer, BufSize) ;πEnd;ππBEGINπEND. 2 08-24-9413:44ALL JOHN HOWARD Is String in File SWAG9408 >: V 31 .l πPROGRAM HI_There;π(* Syntax: there textfile number /quotedstringπ where textfile is filename, number is a line offset, & quotedstring is aπ group of characters without embedded control codes. Purpose is to go to aπ given line offset in the text file, search that line for the string, andπ report via DOS error 1=True or 0=False depending upon if it was there.ππExample: there.exe there.pas 0 /'program'π would return error level 1 (True) since 'program' is on the first line.ππAuthor: John Howard Date: January 5, 1994πCopyright 1994 Howard International, P.O. Box 34633, NKC, MO 64116ππRestrictions: You are free to use this program but I retain commercialπ ownership. You may not charge someone to use this program.πNote: Case sensitive. Front or Back quote is removed. No trailingπ whitespace is removed from the string. Zero-based line offset.π Returns DOS error level values: 0 thru 4 ******* *)π{$DEFINE debug}πVARπ F: text; (* CHAIN.TXT dropfile used by WWIV BBS *)π LineNo: word; (* Line Number from 0..65535 *)π S: string; (* Substring of 1..255 characters *)π CmdLine: string; (* string[127] command-line string *)ππ Test: string; (* temporary search line *)π Code: integer; (* temporary result of VAL conversion *)π I: word; (* temporary index of current line *)π B: byte; (* temporary index of command-line string *)πBEGIN { MAIN }π {$I-} (* Turn OFF input/output checking to prevent run-time error *)π (* Open an existing text file *)π Assign(F, ParamStr(1));π Reset(F);π {$I+} (* Turn ON I/O *)π if (IOResult <> 0) then Halt(2); {writeln('File not found');}π (* Get text from command line and convert into a number *)π Val(ParamStr(2), LineNo, Code);π if Code <> 0 then Halt(3); {writeln('Bad number at position: ', Code);}π (* Get quoted string or un-broken string. NO end whitespace removed! *)π Move(Mem[PrefixSeg:$80], CmdLine, Mem[PrefixSeg:$80] + 1);π S := CmdLine;π{$IFDEF debug} writeln(S); {$ENDIF}π B := Pos( '/', S);π{$IFDEF debug} writeln('CmdLine pos ', B); {$ENDIF}π Delete(S, 1, B);π if S[1] = #39 then Delete(S, 1, 1); (* start quote *)π if S[Length(S)] = #39 then Delete(S, Length(S), 1); (* end quote *)π if S = '' then Halt(4); {writeln('Empty string not allowed');}π{$IFDEF debug} writeln('Line: ', LineNo); {$ENDIF}π{$IFDEF debug} writeln(S); {$ENDIF}π (* Go to specified line within text file *)π I := 0;π while not Eof(F) doπ beginπ Readln(F, Test);π{$IFDEF debug} writeln(Test); {$ENDIF}π if (I = LineNo) thenπ beginπ if Pos(S, Test) > 0 thenπ (* String S matched substr Test at position *)π beginπ Close(F);π{$IFDEF debug} writeln('True ', I); {$ENDIF}π Halt(1); (* Return True *)π endπ elseπ (* Search string not found *)π beginπ Close(F);π{$IFDEF debug} writeln('False ', I); {$ENDIF}π Halt(0); (* Return False *)π end;π end;π (* Move to the next line *)π if (I < 65535) thenπ INC(I) {I := I + 1}π elseπ beginπ Close(F);π Halt(0);π end;π end; {while}π (* Close the existing text file *)π Close(F);π Halt(0); (* Return False *)πEND. { MAIN }ππ 3 08-25-9409:04ALL JOSE CAMPIONE >64K Blockread/BlockwriteSWAG9408 ╙î╬ 65 .l (*************************************************************************ππ =====================================================π Breaking the 64K barrier for BlockRead and BlockWriteπ =====================================================π Copyright (c) 1992,1994 by José Campioneπ Ottawa-Orleans Personal Systems Groupπ Fidonet: 1:163/513.3ππ Turbo Pascal implements two procedures for fast transfer of data from π files to memory blocks and viceversa: Blockread and Blockwrite. One of π the commonly encountered limitation in these procedures is the fact that π they can only handle blocks not exceeding 65535 bytes.ππ This limitation bears a connection with the often asked question on how π to brake the 64K barrier for arrays declared in Pascal. Several answers π have been proposed to this effect. Perhaps one of the most elegant is π the one proposed by Neil Rubenking in his book on Turbo Pascal 6.0 π Techniques and Utilities (Ziff-Davis Press, 1991). Albeit elegant, π Neil's approach uses OOP which may not be fully appreciated by many π Pascal users. ππ So, here is a less ambitious approach with several procedures and π functions permitting the direct handling of large memory blocks. In the π following unit large memory blocks are defined as arrays of blocks eachπ not exceeding 64K. The only limitation for the size of the overall large π block is that it must not exceed the normal RAM. A longint pointer is π then used to access individual positions. ππ This unit uses a modified heapfunc that permits the replacement of "new" π with "getmem". This, together with range checking off, allows an array π to be declared as a single byte. During runtime it can be assigned any π size determined by the program. This ensures that the "tail" of the big π block will never be larger than strictly necessary. ππ Functions BigBlockRead and BigBlockWrite permit the reading and writing π of blocks from and to a file much in the same way as Pascal's BlockReadπ and BlockWrite. Only difference is that the 64K limit is not a problem π anymore. Note that the size of the blocks can only be defined in terms π of bytes and that the file being read or write must have been previously π assigned to variable f (an untyped file declared within the unit). Also, π these are not procedures but functions returning false if the reading or π the writing of the big block was not completed. ππ In the present implementation only one array of big blocks is permitted. π Variable BigBlkExist ensures that MakeBig will only work if a previous π big block has not been created. BigBlk is the array of blocks reserved π in the heap. SizBlk is an array containing the sizes in bytes of each π block reserved in the heap as part of the big block. NumVec contains theπ number of blocks used by the big block. ππ And last, some acknowledgements:ππ Part of this unit was inspired by code contained in a file posted at π garbo.uwasa.fi by Prof. Timo Salmi. The code itself was based on a π submission by Naji Moawad. Prof. Salmi's code contained the following π message: ππ The code below is based on a UseNet posting in comp.lang.pascal by π Naji Mouawad nmouawad@watmath.waterloo.edu. Naji's idea was for a π vector, my adaptation is for a two-dimensional matrix. The realizationπ of the idea is simpler than the one presented by Kent Porter in π Dr.Dobb's Journal, March 1988. π***************************************************************************)ππ{$R-} { R has to be off... }π{$M 8096,0,655360}ππunit bigarru;ππinterfaceππ uses crt,dos;ππ constπ SizVec = $FFFF;π MaxBlk = $FF;ππ typeπ Vec = array [0..0] of byte;ππ varπ BigBlk : array[0..MaxBlk] of ^Vec;π SizBlk : array[0..MaxBlk] of word;π TotSizBlk : longint;π NumVec : byte;π HeapTop : pointer;π BigBlkExist : boolean;ππ {$F+} function HeapFunc(Size: word) : integer; {$F-}π function MakeBig(HeapNeeded: longint): boolean;π function Peek(p: longint; var error: boolean): byte;π procedure Poke(b : byte; p: longint; var error: boolean);π procedure FillRange(fromby, toby :longint; b : byte);π procedure FillAll(b: byte);π function BigBlockRead (var f: file): boolean;π function BigBlockWrite(var f: file): boolean;ππimplementationππ {$F+} function HeapFunc(Size: word) : integer; {$F-}π beginπ HeapFunc:= 1;π end;ππ { Create the dynamic variables }π { HeapNeeded is the needed number of BYTES }π function MakeBig(HeapNeeded: longint): boolean;π varπ i : integer;π error : boolean;π beginπ error:= false;π if BigBlkExist then beginπ Makebig:= false;π exit;π end;π fillchar(sizblk,sizeof(sizblk),0);π NumVec:= (HeapNeeded div SizVec);π if (HeapNeeded < SizVec) then beginπ SizBlk[NumVec]:= HeapNeeded;π BigBlk[NumVec]:= nil;π GetMem(BigBlk[NumVec], SizBlk[NumVec]);π if BigBlk[NumVec] = nil then error:= true;π end else beginπ i:= -1;π while not error and (i < NumVec - 1) do beginπ inc(i,1);π SizBlk[i]:= SizVec;π BigBlk[i]:= nil;π GetMem(BigBlk[i],SizBlk[i]);π if BigBlk[i] = nil then error:= true;π end;π if not error then beginπ SizBlk[NumVec]:= HeapNeeded - ((i + 1) * SizVec);π BigBlk[NumVec]:= nil;π GetMem(BigBlk[NumVec], SizBlk[NumVec]);π if BigBlk[NumVec] = nil then error:= true;π end;π end;π if not error then beginπ TotSizBlk:= HeapNeeded;π BigBlkExist:= true;π MakeBig:= true;π end else beginπ MakeBig:= false;π release(heaptop);π end;π end; { makebig }ππ function Peek(p: longint; var error: boolean): byte;π varπ VecNum: byte;π BytNum: word;π beginπ if BigBlkExist and not (p > totsizblk) then beginπ error:= false;π VecNum:= p div SizVec;π BytNum:= p - (VecNum * SizVec);π peek:= BigBlk[VecNum]^[BytNum];π end else beginπ error:= true;π peek:= 0;π end;π end;ππ procedure Poke(b: byte; p: longint; var error: boolean);π varπ VecNum: byte;π BytNum: word;π beginπ if BigBlkExist and not (p > totsizblk) then beginπ error:= false;π VecNum:= p div SizVec;π BytNum:= p - (VecNum * SizVec);π BigBlk[VecNum]^[BytNum]:= b;π end else error:= true;π end;ππ procedure FillRange(fromby, toby :longint; b : byte);π varπ p: longint;π VecNum: byte;π BytNum: word;π beginπ If BigBlkExist then beginπ for p:= fromby to toby do beginπ VecNum:= p div SizVec;π BytNum:= p - (VecNum * SizVec);π BigBlk[VecNum]^[BytNum]:= b;π end;π end;π end;ππ procedure FillAll(b: byte);π varπ i : byte;π beginπ if BigBlkExist thenπ for i:= 0 to NumVec doπ fillchar(BigBlk[i]^,SizBlk[i],b);π end;ππ function BigBlockRead (var f: file): boolean;π varπ i : integer;π error : boolean;π beginπ error:= false;π BigBlockRead:= true;π {$I-} reset(f,1); {$I+}π if (ioresult = 0) and bigblkexist then beginπ i:= -1;π while not error and (i < NumVec) do beginπ inc(i,1);π {$I-} BlockRead(f,BigBlk[i]^,SizBlk[i]); {$I+}π if ioresult <> 0 then error:= true;π end;π if not error then {$I-}close(f){$I+} else BigBlockRead:= false;π end else BigBlockRead:= false;π end;ππ function BigBlockWrite(var f: file): boolean;π varπ i : integer;π error : boolean;π beginπ error:= false;π BigBlockWrite:= true;π {$I-} rewrite(f,1); {$I+}π if (ioresult = 0) and bigblkexist then beginπ i:= -1;π while not error and (i < NumVec) do beginπ inc(i,1);π {$I-} BlockWrite(f,BigBlk[i]^,SizBlk[i]); {$I+}π if ioresult <> 0 then error:= true;π end;π if not error then {$I-}close(f){$I+} else BigBlockWrite:= false;π end else BigBlockWrite:= false;π end;ππbeginπ heaperror:= @heapfunc;π BigBlkExist:= false;π mark(heaptop);πend.ππ
